home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / PROGRAM / VIS082S.ARJ / CHATOLD.PAS < prev    next >
Pascal/Delphi Source File  |  1991-03-07  |  44KB  |  1,689 lines
  1. {$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }
  2.  
  3. unit chatstuf;        (* Chat Mode and F2 Keys *)
  4.  
  5. interface
  6.  
  7. uses crt,dos,
  8.      gentypes,gensubs,subs1,userret,flags,mainr1,modem,windows,statret,
  9.      configrt,ExecSwap;
  10.  
  11. function specialcommand:boolean;
  12. procedure specialseries;
  13. procedure chat (gotospecial:boolean);
  14. procedure regchat;
  15.  
  16. implementation
  17.  
  18. function specialcommand:boolean;
  19.  
  20.  
  21. Const Right=#205;       (* Constants used to define the arrow keys *)
  22.       Left=#203;
  23.       Up=#200;
  24.       Down=#208;
  25.       NormFore=10;      (* Color Constants *)
  26.       NormBack=1;
  27.       HighFore=4;
  28.       HighBack=7;
  29.       SwapLoc:Array[Boolean] of String[7]=('on disk','in EMS');  (* Full Mem
  30.                                                                      Swaps *)
  31.  
  32. Var C:Char;
  33.     Quit:Boolean;
  34.     Major,Minor,Mainx,Mainy:Integer;
  35.  
  36.     Function ReadStri:Mstr;
  37.     Var MM:Mstr;
  38.     Begin
  39.       ReadLine(MM);
  40.       ReadStri:=MM;
  41.     End;
  42.  
  43.     Procedure SendMsg(M:Lstr);
  44.     Begin
  45.       ClearBreak;
  46.       GotoXy(MainX,MainY);
  47.       ClrEol;
  48.       WriteLn(M);
  49.     End;
  50.  
  51.     Procedure SplitEm;
  52.     Var Cnt:Integer;
  53.     Begin
  54.       If SplitMode then Unsplit;
  55.       GotoXy(1,15);
  56.       TextColor(9);
  57.       For Cnt:=1 to 80 Do Write(Usr,'─');
  58.     End;
  59.  
  60.     Procedure ClearTop;
  61.     Var Cnt:Integer;
  62.     Begin
  63.       For Cnt:=1 to 14 Do
  64.       Begin
  65.         GotoXy(1,Cnt);
  66.         ClrEol;
  67.       End;
  68.     End;
  69.  
  70.     Procedure DrawABox(Count:Integer; Msg:Lstr); (* DrawABox(Rows,Message); *)
  71.     Var Cnt:Integer;
  72.     Begin
  73.     TextColor(NormFore);
  74.     TextBackground(NormBack);
  75.     ClearTop;
  76.     GotoXy(1,1);
  77.     Write(Usr,'┌');
  78.     For Cnt:=1 to 78 Do Write(Usr,'─');
  79.     Write(Usr,'┐');
  80.     For Cnt:=1 to Count Do
  81.       Begin
  82.       GotoXy(1,1+Cnt);
  83.       Write(Usr,'│');
  84.       GotoXy(80,1+Cnt);
  85.       Write(Usr,'│');
  86.       End;
  87.     GotoXy(1,Count+2);
  88.     Write(Usr,'└');
  89.     For Cnt:=1 to (38-(Length(Msg) div 2)) Do
  90.      Write(Usr,'─');
  91.      Write(Usr,'[ '+Msg+' ]');
  92.      While WhereX<80 Do Write(Usr,'─');
  93.      Write(Usr,'┘');
  94.     End;
  95.  
  96.     Procedure DrawMain;
  97.     Begin
  98.       ClearTop;
  99.       GotoXy(22,2);
  100.       TextBackground(NormBack);
  101.       TextColor(NormFore);
  102.       WriteLn(Usr,'ViSiON Online Editing Commands');
  103.       GotoXy(15,4);
  104.       WriteLn(Usr,'[Ret] To accept [Esc] to Exit [Arrows] to Move');
  105.       Major:=1;
  106.       Minor:=1;
  107.     End;
  108.  
  109.     Procedure WriteXy(A,B:Integer; M:String);
  110.     Begin
  111.       GotoXy(A,B);
  112.       Write(Usr,M);
  113.     End;
  114.  
  115.     Procedure UpdateMajor;
  116.     Begin
  117.       TextBackground(NormBack);
  118.       TextColor(NormFore);
  119.       WriteXy(8,6,' User Editing ');
  120.       WriteXy(22,6,' Access Flags ');
  121.       WriteXy(36,6,' Other Commands ');
  122.       WriteXy(52,6,' External Commands ');
  123.       TextBackground(HighBack);
  124.       TextColor(HighFore);
  125.       Case Major of
  126.         1:WriteXy(8,6,' User Editing ');
  127.         2:WriteXy(22,6,' Access Flags ');
  128.         3:WriteXy(36,6,' Other Commands ');
  129.         4:WriteXy(52,6,' External Commands ');
  130.       End;
  131.       TextBackground(0);
  132.       TextColor(15);
  133.     End;
  134.  
  135.     Procedure DoUserEditing;
  136.     Var T:Mstr;
  137.         Tx:Integer;
  138.         LastMinor,Cnet:Integer;
  139.  
  140.      Procedure DoTop;
  141.      Var Cnt:Integer;
  142.      Begin
  143.      DrawABox(12,'ViSiON User Editing');
  144.      Minor:=1;
  145.     End;
  146.  
  147.     Procedure ClearBytes(Byt:Integer);
  148.     Var X,Y,Cnt:Integer;
  149.     Begin
  150.       X:=WhereX;
  151.       Y:=WhereY;
  152.       For Cnt:=1 to Byt Do Write(Usr,' ');
  153.       GotoXy(X,Y);
  154.     End;
  155.  
  156.     Procedure DrawThem;
  157.     Begin
  158.       TextBackGround(NormBack);
  159.       TextColor(NormFore);
  160.       WriteXy(4,2,'[ User #'+Strr(Unum)+' ]  ');
  161.       WriteXy(50,2,'[ PgDn for More ]');
  162.       Case LastMinor of
  163.            1:Begin
  164.               WriteXy(3,3,' Handle ');
  165.               WriteXy(16,3,urec.handle+'         ');
  166.              End;
  167.            2:Begin
  168.               WriteXy(3,4,' Name ');
  169.               WriteXy(16,4,Urec.RealName+'           ');
  170.              End;
  171.            3:Begin
  172.               WriteXy(3,5,' Level ');
  173.               WriteXy(16,5,Strr(Urec.Level)+'    ');
  174.              End;
  175.            4:Begin
  176.               WriteXy(3,6,' G-F Lvl ');
  177.               WriteXy(16,6,Strr(Urec.Glevel)+'    ');
  178.              End;
  179.            5:Begin
  180.               WriteXy(3,7,' G-F Pts ');
  181.               WriteXy(16,7,strr(Urec.Gpoints)+'    ');
  182.              End;
  183.             6:Begin
  184.                WriteXy(3,8,' File Lvl ');
  185.                WriteXy(16,8,Strr(Urec.UDLevel)+'    ');
  186.               End;
  187.             7:Begin
  188.                WriteXy(3,9,' File Pts ');
  189.                WriteXy(16,9,strr(Urec.UDPoints)+'    ');
  190.               End;
  191.             8:Begin
  192.                WriteXy(3,10,' Password ');
  193.                WriteXy(16,10,Urec.PassWord+'    ');
  194.               End;
  195.             9:Begin
  196.                WriteXy(3,11,' Phone Num ');
  197.                WriteXy(16,11,Urec.PhoneNum+'    ');
  198.               End;
  199.             10:Begin
  200.                 WriteXy(3,12,' Daily Time ');
  201.                 WriteXy(16,12,strr(Urec.TimeLimits)+'    ');
  202.                End;
  203.             11:Begin
  204.                 WriteXy(3,13,' User Note ');
  205.                 WriteXy(16,13,Urec.UserNote);
  206.                End;
  207.             15:Begin
  208.                 WriteXy(57,6,' U/D Ratio ');
  209.                 WriteXy(70,6,Strr(Urec.UDRatio)+'    ');
  210.                End;
  211.             12:Begin
  212.                 WriteXy(57,3,' U/D K Ratio ');
  213.                 WriteXy(70,3,strr(Urec.UDKRatio)+'    ');
  214.                End;
  215.             13:Begin
  216.                 WriteXy(57,4,' PCR ');
  217.                 WriteXy(70,4,strr(Urec.PCRatio)+'    ');
  218.                End;
  219.             14:WriteXy(57,5,' Time Left ');
  220.             16:Begin
  221.                 WriteXy(57,7,' Posts ');
  222.                 WriteXy(70,7,Strr(Urec.Nbu));
  223.                End;
  224.             17:Begin
  225.                 WriteXy(57,8,' Uploads ');
  226.                 WriteXy(70,8,Strr(Urec.Uploads));
  227.                End;
  228.             18:Begin
  229.                 WriteXy(57,9,' Downloads ');
  230.                 WriteXy(70,9,Strr(Urec.Downloads));
  231.                End;
  232.             19:Begin
  233.                 WriteXy(57,10,' U/L KB ');
  234.                 WriteXy(70,10,Strr(Urec.UpKay)+'k');
  235.                End;
  236.             20:Begin
  237.                 WriteXy(57,11,' D/L KB ');
  238.                 WriteXy(70,11,Strr(Urec.Dnkay)+'k');
  239.                End;
  240.             21:Begin
  241.                 WriteXy(57,12,' Calls ');
  242.                 WriteXy(70,12,Strr(Urec.NumOn));
  243.                End;
  244.             22:Begin
  245.                 WriteXy(57,13,' Exp Date ');
  246.                 If DateStr(Urec.ExpDate)='0/0/80' then WriteXy(70,13,'N/A      ')
  247.                   Else
  248.                 WriteXy(70,13,DateStr(Urec.ExpDate));
  249.                End;
  250.             End; (* End Case *)
  251.       TextBackGround(HighBack);
  252.       TextColor(HighFore);
  253.       Case Minor of
  254.           1:WriteXy(3,3,' Handle ');
  255.           2:WriteXy(3,4,' Name ');
  256.           3:WriteXy(3,5,' Level ');
  257.           4:WriteXy(3,6,' G-F Lvl ');
  258.           5:WriteXy(3,7,' G-F Pts ');
  259.           6:WriteXy(3,8,' File Lvl ');
  260.           7:WriteXy(3,9,' File Pts ');
  261.           8:WriteXy(3,10,' Password ');
  262.           9:WriteXy(3,11,' Phone Num ');
  263.           10:WriteXy(3,12,' Daily Time ');
  264.           11:WriteXy(3,13,' User Note ');
  265.           15:WriteXy(57,6,' U/D Ratio ');
  266.           12:WriteXy(57,3,' U/D K Ratio ');
  267.           13:WriteXy(57,4,' PCR ');
  268.           14:WriteXy(57,5,' Time Left ');
  269.           16:WriteXy(57,7,' Posts ');
  270.           17:WriteXy(57,8,' Uploads ');
  271.           18:WriteXy(57,9,' Downloads ');
  272.           19:WriteXy(57,10,' U/L KB ');
  273.           20:WriteXy(57,11,' D/L KB ');
  274.           21:WriteXy(57,12,' Calls ');
  275.           22:WriteXy(57,13,' Exp Date ');
  276.       End;
  277.       LastMinor:=Minor;
  278.       TextBackground(NormBack);
  279.       TextColor(NormFore);
  280.     End;
  281.  
  282.     Procedure Goty(X,Y,B:Integer);
  283.     Begin
  284.     GotoXy(X,Y);
  285.     ClearBytes(b);
  286.     End;
  287.  
  288.     Procedure DoSecondPage;
  289.  
  290.       Procedure DoT;
  291.       Begin
  292.        DrawABox(9,'ViSiON User Editing Page 2');
  293.        Minor:=1;
  294.       End;
  295.  
  296.       Procedure DrawSome;
  297.       Begin
  298.        TextColor(NormFore);
  299.        TextBackground(NormBack);
  300.        WriteXy(3,2,'[ User # '+Strr(Unum)+' ]');
  301.        WriteXy(50,2,'[ PgUp for More ]');
  302.        WriteXy(3,3,' Time in bank ');
  303.        WriteXy(19,3,Strr(Urec.TimeBank));
  304.        WriteXy(3,4,' G-File Uls ');
  305.        WriteXy(19,4,Strr(Urec.Nup));
  306.        WriteXy(3,5,' G-File Dls ');
  307.        WriteXy(19,5,Strr(Urec.Ndn));
  308.        WriteXy(3,6,' Sysop Note ');
  309.        WriteXy(19,6,Urec.SpecialSysopNote);
  310.        WriteXy(3,7,' Wanted Flag ');
  311.        WriteXy(19,7,YesNo(Wanted in Urec.Config)+' ');
  312.        WriteXy(3,8,' Macro 1 ');
  313.        WriteXy(19,8,Urec.Macro1);
  314.        WriteXy(3,9,' Macro 2 ');
  315.        WriteXy(19,9,Urec.Macro2);
  316.        WriteXy(3,10,' Macro 3 ');
  317.        WriteXy(19,10,urec.macro3);
  318.        TextColor(HighFore);
  319.        TextBackground(HighBack);
  320.        Case Minor of
  321.          1:WriteXy(3,3,' Time in bank ');
  322.          2:WriteXy(3,4,' G-File Uls ');
  323.          3:WriteXy(3,5,' G-File Dls ');
  324.          4:WriteXy(3,6,' Sysop Note ');
  325.          5:WriteXy(3,7,' Wanted Flag ');
  326.          6:WriteXy(3,8,' Macro 1 ');
  327.          7:WriteXy(3,9,' Macro 2 ');
  328.          8:WriteXy(3,10,' Macro 3 ');
  329.        End;
  330.        TextColor(NormFore);
  331.        TextBackground(NormBack);
  332.       End;
  333.  
  334.       Begin
  335.         DoT;
  336.         Repeat
  337.           DrawSome;
  338.           C:=BiosKey;
  339.           Case C of
  340.             Left,Up:Dec(Minor);
  341.             Right,Down:Inc(Minor);
  342.             #13:Begin
  343.                 GotY(19,Minor+2,37);
  344.                 Case Minor of
  345.                  1:Begin
  346.                     T:=ReadStri;
  347.                     Tx:=Valu(T);
  348.                     Urec.TimeBank:=Tx;
  349.                     SendMsg('Your time in your time bank has been set to '+Strr(Tx));
  350.                    End;
  351.                  2:Begin
  352.                     T:=ReadStri;
  353.                     Tx:=Valu(T);
  354.                     Urec.Nup:=Tx;
  355.                     SendMsg('Your G-File Uploads have been set to '+Strr(Tx));
  356.                    End;
  357.                  3:Begin
  358.                     T:=ReadStri;
  359.                     Tx:=Valu(T);
  360.                     Urec.Ndn:=Tx;
  361.                     SendMsg('Your G-File Downloads have been set to '+Strr(Tx));
  362.                    End;
  363.                  4:Begin
  364.                     T:=ReadStri;
  365.                     If T<>'' then Urec.SpecialSysopNote:=T;
  366.                    End;
  367.                  5:If Wanted in Urec.Config then Urec.Config:=Urec.Config-[Wanted] Else
  368.                     Urec.Config:=Urec.Config+[Wanted];
  369.                  6:Begin
  370.                     T:=ReadStri;
  371.                     If T<>'' then Urec.Macro1:=T;
  372.                     SendMsg('Your macro #1 has been changed to '+T);
  373.                    End;
  374.                  7:Begin
  375.                     t:=readstri;
  376.                     if t<>'' then Urec.Macro2:=T;
  377.                     SendMsg('Your Macro #2 has been changed to '+T);
  378.                    End;
  379.                  8:Begin
  380.                     t:=ReadStri;
  381.                     If T<>'' then Urec.Macro2:=T;
  382.                     SendMsg('Your Macro #3 has been changed to '+T);
  383.                    End;
  384.             End;
  385.             c:=#0;
  386.           End;
  387.           End;
  388.             If Minor=0 then Minor:=8;
  389.             If Minor=9 then Minor:=1;
  390.         Until C in [#27,#201];
  391.       End;
  392.  
  393.     Begin
  394.       DoTop;
  395.       LastMinor :=1;
  396.       For Cnet:=1 to 22 Do
  397.       Begin
  398.         Minor:=Cnet;
  399.         Drawthem;
  400.         End;
  401.       Minor:=1;
  402.       DrawThem;
  403.       Repeat
  404.         C:=BiosKey;
  405.          Case C Of
  406.            Up:Dec(Minor);
  407.            Down:Inc(Minor);
  408.            Right,Left:If Minor<12 then Minor:=Minor+11 Else Minor:=Minor-11;
  409.            #209:Begin
  410.                 DoSecondPage;
  411.                 If C<>#27 then Begin
  412.                 DoTop;
  413.                 LastMinor:=1;
  414.                 For Cnet:=1 to 22 do
  415.                  Begin
  416.                    Minor:=Cnet;
  417.                    DrawThem;
  418.                    End;
  419.                  Minor:=1;
  420.                  DrawThem;
  421.                  End;
  422.            End;
  423.            #13:Begin
  424.                If Minor<12 Then Goty(16,Minor+2,35)
  425.                  Else
  426.                  Goty(70,Minor+2-11,5);
  427.                Case Minor Of
  428.                 1:Begin
  429.                    T:=ReadStri;
  430.                    If T<>'' then Urec.Handle:=T;
  431.                    SendMsg('Your Handle has been changed to '+Urec.Handle);
  432.                   End;
  433.                 2:Begin
  434.                    T:=ReadStri;
  435.                    If T<>'' then Urec.RealName:=T;
  436.                    SendMsg('Your Real Name has been Changed to '+Urec.RealName);
  437.                   End;
  438.                 3:Begin
  439.                    T:=ReadStri;
  440.                    Tx:=Valu(T);
  441.                    Urec.Level:=Tx;
  442.                    Ulvl:=Tx;
  443.                    SendMsg('You have been granted '+Strr(Urec.Level)+' Access.');
  444.                   End;
  445.                 4:Begin
  446.                    T:=ReadStri;
  447.                    Tx:=Valu(T);
  448.                    Urec.Glevel:=Tx;
  449.                    SendMsg('Your G-File Level has been changed to '+Strr(Urec.Glevel));
  450.                   End;
  451.                 5:Begin
  452.                    T:=ReadStri;
  453.                    Tx:=Valu(T);
  454.                    Urec.Gpoints:=Tx;
  455.                    SendMsg('You have been given '+Strr(Urec.Gpoints)+' G-File Points');
  456.                   End;
  457.                 6:Begin
  458.                    T:=ReadStri;
  459.                    Tx:=Valu(T);
  460.                    Urec.Udlevel:=Tx;
  461.                    SendMsg('Your Upload/Download Level has been set to '+Strr(Urec.UdLevel));
  462.                   End;
  463.                 7:Begin
  464.                    T:=ReadStri;
  465.                    Tx:=Valu(T);
  466.                    Urec.UdPoints:=Tx;
  467.                    SendMsg('You now have '+strr(Urec.UdPoints)+' file points.');
  468.                   End;
  469.                 8:Begin
  470.                    T:=ReadStri;
  471.                    If T<>'' then Urec.Password:=T;
  472.                    SendMsg('Your password has been changed to '+Urec.Password);
  473.                   End;
  474.                 9:Begin
  475.                    T:=ReadStri;
  476.                    If T<>'' then Urec.PhoneNum:=T;
  477.                    SendMsg('Your Phone Number has been changed to '+Urec.PhoneNum);
  478.                   End;
  479.                 10:Begin
  480.                     T:=ReadStri;
  481.                     Tx:=Valu(T);
  482.                     Urec.TimeLimits:=Tx;
  483.                     SendMsg('Your daily time limit has been set to '+Strr(Urec.TimeLimits));
  484.                    End;
  485.                 11:Begin
  486.                     T:=ReadStri;
  487.                     If T<>'' then
  488.                       Urec.UserNote:=T;
  489.                     SendMsg('Your Account Note has been Changed to '+Urec.UserNote);
  490.                    End;
  491.                 15:Begin
  492.                     T:=ReadStri;
  493.                     Tx:=Valu(T);
  494.                     Urec.UDRatio:=Tx;
  495.                     SendMsg('Your minimum Upload/Download ratio has been set to '+Strr(Urec.UdRatio));
  496.                    End;
  497.                 12:Begin
  498.                     T:=ReadStri;
  499.                     Tx:=Valu(T);
  500.                     Urec.UDKRatio:=Tx;
  501.                     SendMsg('Your minimum Upload/Download K Ratio has been set to '+Strr(urec.Udkratio));
  502.                    End;
  503.                 13:Begin
  504.                     T:=ReadStri;
  505.                     Tx:=Valu(T);
  506.                     Urec.PCRatio:=Tx;
  507.                     SendMsg('Your minimum Post/Call Ratio has been set to '+Strr(Urec.PCRatio));
  508.                    End;
  509.                 14:Begin
  510.                     T:=ReadStri;
  511.                     GotY(70,5,5);
  512.                     SetTimeLeft(Valu(T));
  513.                     bottomline;
  514.                     SendMsg('You have been given '+Strr(Valu(T))+' Minutes for today.');
  515.                    End;
  516.                 16:Begin
  517.                     T:=ReadStri;
  518.                     Tx:=Valu(T);
  519.                     Urec.Nbu:=Tx;
  520.                     SendMsg('Your POSTS have been set to '+Strr(Urec.Nbu));
  521.                    End;
  522.                 17:Begin
  523.                     T:=ReadStri;
  524.                     Tx:=Valu(T);
  525.                     Urec.Uploads:=Tx;
  526.                     SendMsg('Your Uploads have been set to '+Strr(Urec.Uploads));
  527.                    End;
  528.                 18:Begin
  529.                    T:=ReadStri;
  530.                    Tx:=Valu(T);
  531.                    Urec.Downloads:=Tx;
  532.                    SendMsg('Your Downloads have been set to '+Strr(Urec.Downloads));
  533.                   End;
  534.                 19:Begin
  535.                     T:=ReadStri;
  536.                     Tx:=Valu(T);
  537.                     Urec.UpKay:=Tx;
  538.                     SendMsg('Your Upload K-Bytes have been set to '+Strr(Tx)+'k');
  539.                    End;
  540.                 20:Begin
  541.                     T:=ReadStri;
  542.                     Tx:=Valu(T);
  543.                     Urec.DnKay:=Tx;
  544.                     SendMsg('Your Download K-Bytes have been set to '+Strr(Tx)+'k');
  545.                    End;
  546.                 21:Begin
  547.                     T:=ReadStri;
  548.                     Tx:=Valu(T);
  549.                     Urec.NumOn:=Tx;
  550.                     SendMsg('Your total calls have been set to '+Strr(Tx));
  551.                    End;
  552.                 22:Begin
  553.                     T:=ReadStri;
  554.                     If T<>'' then Begin
  555.                       Urec.ExpDate:=DateVal(T);
  556.                       SendMsg('Your Expiration Date has been set to '+DateStr(Urec.ExpDate));
  557.                    End;
  558.                 End;
  559.                End;
  560.            End;
  561.          End;
  562.          If Minor=23 then Minor:=1;
  563.          If Minor=0 then Minor:=22;
  564.         DrawThem;
  565.       Until C=#27;
  566.     End;
  567.  
  568.   Procedure DoAccessFlags;
  569.  
  570.   Procedure DrawTop;
  571.   Var Cnt:Integer;
  572.   Begin
  573.    DrawABox(4,'Access Flag Editing Commands');
  574.    Minor:=1;
  575.   End;
  576.  
  577.   Procedure GetMainConferences;
  578.  
  579.      Procedure DrawT;
  580.      Var Cnt:Integer;
  581.      Begin
  582.        DrawABox(5,'Access to Main Conferences');
  583.        Minor:=1;
  584.      End;
  585.  
  586.    Procedure Choices;
  587.    Var CountMe:Integer;
  588.    Begin
  589.     TextBackground(NormBack);
  590.     TextColor(NormFore);
  591.     for countme:=1 to 5 do
  592.     Begin
  593.       GotoXy(31,1+CountMe);
  594.       Write(Usr,' Conference ',countme,' - ');
  595.       if Urec.Conf[CountMe] then Write(Usr,'Yes ') else
  596.        Write(Usr,'No  ');
  597.     End;
  598.     GotoXy(31,1+Minor);
  599.     TextColor(HighFore);
  600.     TextBackground(HighBack);
  601.     Write(Usr,' Conference ',Minor,' - ');
  602.     If Urec.Conf[Minor] then Write(Usr,'Yes ') else Write(Usr,'No  ');
  603.     TextColor(NormFore);
  604.     TextBackground(NormBack);
  605.     End;
  606.  
  607.  
  608.    Begin
  609.      DrawT;
  610.      Repeat
  611.       Choices;
  612.       C:=BiosKey;
  613.       Case C Of
  614.         Left,Up:Dec(Minor);
  615.         Down,Right:Inc(Minor);
  616.         #13:Begin
  617.             Urec.Conf[Minor]:=Not Urec.Conf[Minor];
  618.             If Urec.Conf[Minor] then SendMsg('You have been granted access to main conference #'+Strr(Minor))
  619.             Else SendMsg('You have been denied access to Main Conference #'+Strr(Minor));
  620.           End;
  621.        End;
  622.        If Minor>5 then Minor:=1;
  623.        If Minor<1 then Minor:=5;
  624.       Until C=#27;
  625.    End;
  626.  
  627.   Procedure GetSubConferences;
  628.   Var T:Mstr;
  629.       Tx:Integer;
  630.  
  631.   Procedure ShowSubs;
  632.    Var Cnt:Integer;
  633.    Begin
  634.      ClearTop;
  635.      GotoXy(1,1);
  636.      WriteLn(Usr,'                       Sub Conference Access Flags');
  637.      Write(Usr,^M^J);
  638.      Write(Usr,'         ');
  639.      For Cnt:=1 to 18 do
  640.       If Urec.Confset[Cnt]>0 then Write(Usr,Cnt,',') Else
  641.       Write(Usr,'0,');
  642.      Write(Usr,^M^J);
  643.      Write(Usr,'         ');
  644.      For Cnt:=19 to 31 Do
  645.        If Urec.Confset[Cnt]>0 then Write(Usr,Cnt,',') Else
  646.        Write(Usr,'0,');
  647.      If Urec.ConfSet[32]>0 then WriteLn(Usr,'32') else writeLn(Usr,'0');
  648.    End;
  649.  
  650.    Begin
  651.      Repeat
  652.        ShowSubs;
  653.        Write(Usr,^M^J);
  654.        Write(Usr,'Enter conference to change, or [Return] to exit:');
  655.        T:=ReadStri;
  656.        If T<>'' then Begin
  657.          Tx:=Valu(T);
  658.          If (Tx>0) and (TX<33) then
  659.            If Urec.ConfSet[Tx]=0 then Urec.Confset[Tx]:=1 Else
  660.            Urec.Confset[Tx]:=0;
  661.          End;
  662.        Until T='';
  663.      End;
  664.  
  665.  
  666.   Procedure DrawChoices;
  667.   Begin
  668.     TextBackGround(NormBack);
  669.     TextColor(NormFore);
  670.     GotoXy(15,3);
  671.     Write(Usr,' Main Conferences ');
  672.     GotoXy(50,3);
  673.     Write(Usr,' Sub-Conferences ');
  674.     GotoXy(15,4);
  675.     Write(Usr,' Sub-Board Access ');
  676.     GotoXy(50,4);
  677.     Write(Usr,' Set SysOp Access ');
  678.     TextBackground(HighBack);
  679.     TextColor(HighFore);
  680.     Case Minor Of
  681.        1:Begin
  682.           GotoXy(15,3);
  683.           Write(Usr,' Main Conferences ');
  684.          End;
  685.        2:Begin
  686.           GotoXy(50,3);
  687.           Write(Usr,' Sub-Conferences ');
  688.          End;
  689.        3:Begin
  690.          GotoXy(15,4);
  691.          Write(Usr,' Sub-Board Access ');
  692.         End;
  693.        4:Begin
  694.          GotoXy(50,4);
  695.          Write(Usr,' Set SysOp Access ');
  696.        End;
  697.     End;
  698.     TextColor(NormFore);
  699.     TextBackground(NormBack);
  700.   End;
  701.  
  702.   procedure getnewaccess;
  703.   var q,bname:sstr;
  704.       bn:integer;
  705.       ac:accesstype;
  706.       wasopen:boolean;
  707.       k:char;
  708.  
  709.     function inputaccess (q:sstr):accesstype;
  710.     begin
  711.       inputaccess:=invalid;
  712.       if length(q)=0 then exit;
  713.       case upcase(q[1]) of
  714.         'L':inputaccess:=letin;
  715.         'B':inputaccess:=bylevel;
  716.         'K':inputaccess:=keepout
  717.       end
  718.     end;
  719.  
  720.     procedure getallaccess;
  721.  
  722.       procedure setallaccess (ac:accesstype);
  723.       var cnt:integer;
  724.       begin
  725.         setalluserflags (urec,ac);
  726.         SendMsg ('Your access to all sub-boards: '+accessstr[ac]);
  727.         writeurec
  728.       end;
  729.  
  730.     begin
  731.       Write (Usr,'ALL acc. ([B]y level, [L]et in, [K]eep out, or CR): ');
  732.       Q:=ReadStri;
  733.       ac:=inputaccess(q);
  734.       if ac<>invalid then setallaccess(ac)
  735.     end;
  736.  
  737.   var bd:boardrec;
  738.   begin
  739.     ClearTop;
  740.     GotoXy(25,1);
  741.     WriteLn(Usr,'Change Sub-Board Access');
  742.     GotoXy(1,3);
  743.     Write(Usr,'Which Sub-Board to change access for [''*''/ALL]: ');
  744.     Bname:=ReadStri;
  745.     if length(bname)<1 then exit;
  746.     if bname='*' then
  747.       begin
  748.         getallaccess;
  749.         exit
  750.       end;
  751.     opentempbdfile;
  752.     bn:=searchboard(bname);
  753.     if bn=-1 then
  754.       begin
  755.         closetempbdfile;
  756.         Write(Usr,'No such board! Press any key..');
  757.         k:=bioskey;
  758.         exit
  759.       end;
  760.     writeln (Usr,'Board '+bname+'... Current access: '+accessstr[getuseraccflag(urec,bn)]);
  761.     Write(Usr,'Access ([B]y level, [L]et in, [K]eep out, or [CR]: ');
  762.     q:=readstri;
  763.     ac:=inputaccess(q);
  764.     if ac=invalid then begin
  765.       closetempbdfile;
  766.       exit
  767.     end;
  768.     setuseraccflag (urec,bn,ac);
  769.     writeurec;
  770.     closetempbdfile;
  771.     SendMsg ('New access for sub-board '+bname+': '+accessstr[ac])
  772.   end;
  773.  
  774.   procedure getsysopaccess;
  775.   const sysopstr:array [false..true] of string[6]=('Normal','Sysop');
  776.         sectionnames:array [udsysop..databasesysop] of string[20]=
  777.           ('File transfer','Bulletin section','Voting booths',
  778.            'E-mail section','Doors','Main menu','Databases');
  779.   var cnt:configtype;
  780.       x:string[10];
  781.       n,mx:integer;
  782.       v:boolean;
  783.   begin
  784.     repeat
  785.       ClearTop;
  786.       GotoXy(1,1);
  787.       mx:=1;
  788.       for cnt:=udsysop to databasesysop do begin
  789.         write (usr,mx:3,'. ',sectionnames[cnt]);
  790.         mx:=mx+1;
  791.         gotoxy (25,wherey);
  792.         writeln (usr,sysopstr[cnt in urec.config])
  793.       end;
  794.       write (usr,^M^J'Number to toggle [CR to exit]: ');
  795.       readline (x);
  796.       n:=valu(x);
  797.       v:=(n>0) and (n<mx);
  798.       if v then begin
  799.         cnt:=configtype(ord(udsysop)+n-1);
  800.         if cnt in urec.config
  801.           then
  802.             begin
  803.               urec.config:=urec.config-[cnt];
  804.               x:='denied'
  805.             end
  806.           else
  807.             begin
  808.               urec.config:=urec.config+[cnt];
  809.               x:='granted'
  810.             end;
  811.         SendMsg ('You have been '+x+' sysop priveleges for the '+
  812.                  sectionnames[cnt]+'.')
  813.       end
  814.     until not v;
  815.     writeurec
  816.   end;
  817.  
  818.  
  819.  
  820.   Begin
  821.     DrawTop;
  822.     DrawChoices;
  823.     Repeat
  824.      C:=BiosKey;
  825.      Case C of
  826.       Right,Down:Inc(Minor);
  827.       Up,Left:Dec(Minor);
  828.       #13:Begin
  829.          Case Minor Of
  830.            1:GetMainConferences;
  831.            2:GetSubConferences;
  832.            3:GetNewAccess;
  833.            4:GetSysOpAccess;
  834.          End;
  835.          DrawTop;
  836.          C:=#0;
  837.          WriteUrec;
  838.          End;
  839.      End;
  840.      If Minor>4 then Minor:=1;
  841.      If Minor<1 then Minor:=4;
  842.      DrawChoices;
  843.     Until C=#27;
  844.   End;
  845.  
  846.   Procedure DoOther;
  847.  
  848.     Procedure DrawT;
  849.     Var Cnt:Integer;
  850.     Begin
  851.      DrawABox(4,'ViSiON Other Commands');
  852.      Minor:=1;
  853.     End;
  854.  
  855.   Procedure Choices;
  856.   Begin
  857.     GotoXy(15,3);
  858.     TextColor(NormFore);
  859.     TextBackGround(NormBack);
  860.     Write(Usr,' Hang Up On User ');
  861.     Gotoxy(52,3);
  862.     Write(Usr,' Nuke User ');
  863.     GotoXy(15,4);
  864.     Write(Usr,' Snoop Mode [ON] ');
  865.     GotoXy(52,4);
  866.     Write(Usr,' Snoop Mode [OFF] ');
  867.     TextColor(HighFore);
  868.     TextBackGround(HighBack);
  869.     Case Minor of
  870.       1:Begin
  871.         GotoXy(15,3);
  872.         Write(Usr,' Hang Up On User ');
  873.         End;
  874.       2:Begin
  875.         GotoXy(52,3);
  876.         Write(Usr,' Nuke User ');
  877.         End;
  878.       3:Begin
  879.         GotoXy(15,4);
  880.         Write(Usr,' Snoop Mode [ON] ');
  881.       End;
  882.       4:Begin
  883.         GotoXy(52,4);
  884.         Write(Usr,' Snoop Mode [OFF] ');
  885.       End;
  886.     End;
  887.     TextColor(NormFore);
  888.     TextBackground(NormBack);
  889.   End;
  890.  
  891.  
  892.   Begin
  893.   DrawT;
  894.   Repeat
  895.     Choices;
  896.     C:=BiosKey;
  897.     Case C of
  898.       Left,Up:Dec(Minor);
  899.       Down,Right:Inc(Minor);
  900.       #13:Case Minor of
  901.          1:Begin
  902.             SendMsg('Sorry but the BBS is going down right now!');
  903.             ForceHangup:=True;
  904.             HangUp;
  905.            End;
  906.          2:Begin
  907.             Urec.Level:=-1;
  908.             SendMsg('You''re Nuked BUDDY!');
  909.             ForceHangup:=True;
  910.             HangUp;
  911.            End;
  912.          3:Begin
  913.             ModemInlock:=True;
  914.               SetOutLock(True);
  915.             SendMsg('All I/O to the modem is suspended');
  916.            End;
  917.          4:Begin
  918.             SendMsg('All I/O to the modem is reinstated.');
  919.             ModemInlock:=False;
  920.               SetOutLock(False);
  921.            End;
  922.          End;
  923.       End;
  924.       If Minor>4 then Minor:=1;
  925.       If Minor<1 then Minor:=4;
  926.   Until C=#27;
  927.   End;
  928.  
  929.   Procedure DoExternal;
  930.     Procedure DrawT;
  931.     Var Cnt:Integer;
  932.     Begin
  933.       DrawABox(5,'ViSiON External Commands');
  934.       Minor:=1;
  935.     End;
  936.  
  937.     Procedure Choices;
  938.     Begin
  939.      TextColor(NormFore);
  940.      TextBackGround(NormBack);
  941.      GotoXy(15,3);
  942.      Write(Usr,' Full Drop to Dos ');
  943.      GotoXy(50,3);
  944.      Write(Usr,' Shell to Dos ');
  945.      GotoXy(15,4);
  946.      Write(Usr,' Run Text Editor ');
  947.      GotoXy(50,4);
  948.      Write(Usr,' Run Config ');
  949.      TextColor(HighFore);
  950.      TextBackGround(HighBack);
  951.      Case Minor of
  952.        1:Begin
  953.           GotoXy(15,3);
  954.           Write(Usr,' Full Drop to Dos ');
  955.           End;
  956.        2:Begin
  957.           GotoXy(50,3);
  958.           Write(Usr,' Shell to Dos ');
  959.           End;
  960.        3:Begin
  961.           GotoXy(15,4);
  962.           Write(Usr,' Run Text Editor ');
  963.           End;
  964.        4:Begin
  965.           GotoXy(50,4);
  966.           Write(Usr,' Run Config ');
  967.        End;
  968.      End;
  969.      TextColor(NormFore);
  970.      TextBackground(NormBack);
  971.     End;
  972.  
  973.   procedure gotodos (i:integer);
  974.   var status:word;
  975.       tmp1:integer;
  976.       st:mstr;
  977.   begin
  978.     SendMsg ('[ Sysop in DOS ]');
  979.     ansicolor(15);
  980.     window (1,1,80,25);
  981.     gotoxy (1,25);
  982.     writeln (usr,^M^J^J^J);
  983.     updateuserstats (false);
  984.     if i=1 then begin
  985.        clrscr; textcolor(15);
  986.        writeln(usr,'«« ViSiON Dos Shell »»');
  987.        writeln(usr,'Type ''EXIT'' to return.'^M);
  988.        tmp1:=timeleft;
  989.        if not configset.maximumdosshell then begin
  990.         swapvectors;
  991.         exec(getenv('COMSPEC'),'');
  992.         swapvectors;
  993.        End Else Begin
  994.          WriteLn(Usr,'Allocated ',bytesswapped,' bytes ',swaploc[EmsAllocated]);
  995.          SwapVectors;
  996.          Status:=ExecWithSwap(GetEnv('Comspec'),'');
  997.          SwapVectors;
  998.         (* End; *)
  999.         End;
  1000.        st:=configset.forumdi;
  1001.        if st[length(st)]='\' then st[length(st)]:=#0;
  1002.        chdir(st);
  1003.        settimeleft(tmp1);
  1004.        bottomline;
  1005.        end else if i=2 then begin
  1006.      ensureclosed;
  1007.      writereturnbat;
  1008.      closeport;
  1009.      halt (4);
  1010.     end;
  1011.     ClrScr;
  1012.   end;
  1013.  
  1014.   procedure dotexteditor;
  1015.   begin
  1016.     if length(configset.edito)<1 then exit;
  1017.     SendMsg ('[ Sysop is loading text editor ]');
  1018.     window (1,1,80,25);
  1019.     gotoxy (1,25);
  1020.     writeln (usr,^M^J^J^J);           updateuserstats (false);
  1021.     exec(GetEnv('COMSPEC'), '/C '+configset.edito);
  1022.   end;
  1023.  
  1024. procedure runconfig;
  1025. var status:word;
  1026. begin
  1027.  if configset.forumdi[length(configset.forumdi)]<>'\' then configset.forumdi:=configset.forumdi+'\';
  1028.  swapvectors;
  1029.  exec(getenv('COMSPEC'), '/C CONFIG.EXE');
  1030.  swapvectors;
  1031.  readconfig;
  1032. end;
  1033.  
  1034.  
  1035.     Begin
  1036.       DrawT;
  1037.       Repeat
  1038.       Choices;
  1039.         C:=BiosKey;
  1040.         Case C Of
  1041.          Left,Up:Dec(Minor);
  1042.          Right,Down:Inc(Minor);
  1043.          #13:Case Minor of
  1044.             1:GotoDos(2);
  1045.             2:Begin
  1046.                GotoDos(1);
  1047.                Quit:=True;
  1048.               End;
  1049.             3:Begin
  1050.               DoTextEditor;
  1051.               Quit:=True;
  1052.             End;
  1053.             4:Begin
  1054.                RunConfig;
  1055.                Quit:=True;
  1056.             End;
  1057.          End;
  1058.         End;
  1059.         If Minor<1 then Minor:=4;
  1060.         If Minor>4 then Minor:=1;
  1061.       Until (C=#27) or Quit;
  1062.       BottomLine;
  1063.     End;
  1064.  
  1065. Begin
  1066.   ClrScr;
  1067.   GotoXy(1,20);
  1068.   WriteLn(^R'■ '^S'Please Wait '^R'■');
  1069.   MainX:=WhereX;
  1070.   MainY:=WhereY;
  1071.   SplitEm;
  1072.   DrawMain;
  1073.   Quit:=False;
  1074.   BufLen:=40;
  1075.   Repeat
  1076.    UpDateMajor;
  1077.    C:=BiosKey;
  1078.    Case C Of
  1079.      Right,Down:Inc(Major);
  1080.      Left,Up:Dec(Major);
  1081.      #13:Begin
  1082.         Case Major of
  1083.         1:DoUserEditing;
  1084.         2:DoAccessFlags;
  1085.         3:DoOther;
  1086.         4:DoExternal;
  1087.         End;
  1088.         C:=#0;
  1089.         DrawMain;
  1090.      End;
  1091.    End;
  1092.      If Major=0 then Major:=4;
  1093.      If Major=5 then Major:=1;
  1094.    Until (C=#27) or Quit;
  1095.    ClrScr;
  1096.    SpecialCommand:=True;
  1097. End;
  1098.  
  1099. procedure specialseries;
  1100. begin
  1101.   repeat until specialcommand
  1102. end;
  1103.  
  1104. procedure chat (gotospecial:boolean);
  1105. var k:char;
  1106.     StartedTime:Word;
  1107.     cnt,displaywid:integer;
  1108.     quit,carrierloss,fromkbd:boolean;
  1109.     baudstr,commstr:mstr;
  1110.     c1,c2,c3,c4,c5,c6,c7,c8,backup:byte;
  1111.  
  1112.     xsys     :byte;
  1113.     ysys     :byte;
  1114.     xusr     :byte;
  1115.     yusr     :byte;
  1116.     curcolor :byte;
  1117.     ec       :byte;
  1118.     initi    :boolean;
  1119.     linebufs :string[80];
  1120.     linebufu :string[80];
  1121.  
  1122.     Procedure UseCrazyChat;
  1123.     Var Choice,bustout:Boolean;
  1124.         C:Char;
  1125.      Procedure WhichOne;
  1126.      Begin
  1127.       SplitScreen(23);
  1128.       top;
  1129.       TextColor(1); GoToXy(25,3);
  1130.       Write(usr,'ViSiON v0.75 - (C) Ruthless Enterprises 1991');
  1131.       Textcolor(15);
  1132.       GoToXy(35,5); Write(usr,' Use Regular Colored Chat ');
  1133.       GoToXy(35,7); Write(usr,' Use Multiple Colored Chat');
  1134.      End;
  1135.       Procedure WhichBar;
  1136.       Begin
  1137.       If Choice then Begin
  1138.         textcolor(15); GotoXy(35,7); Write (usr,' Use Multiple Colored Chat');
  1139.         textcolor(31); GoToXy(35,5); Write (usr,' Use Regular Colored Chat ');
  1140.       End Else Begin
  1141.         textcolor(15); Gotoxy(35,5); Write (usr,' Use Regular Colored Chat ');
  1142.         textcolor(31); GoToXy(35,7); Write (usr,' Use Multiple Colored Chat');
  1143.         End;
  1144.       End;
  1145.       Begin
  1146.         bustout:=False;
  1147.         WhichOne;
  1148.         CrazyChat:=False;
  1149.         Choice:=True;
  1150.         Repeat
  1151.          WhichBar;
  1152.          C:=Bioskey;
  1153.          Case C Of
  1154.           #205:Begin Choice:=False; End;
  1155.           #203:Begin Choice:=True; End;
  1156.           #13:Begin
  1157.                If Not Choice then CrazyChat:=True Else
  1158.                CrazyChat:=False;
  1159.                bustout:=true;
  1160.               End;
  1161.           End;
  1162.           Until bustout;
  1163.           unsplit;
  1164.         End;
  1165.  
  1166.     Procedure ChangeVars;
  1167.       Begin
  1168.        backup:=c1;
  1169.        c1:=c2; c2:=c3; c3:=c4; c4:=c5; c5:=c6; c6:=c7; c7:=c8; c8:=backup;
  1170.        ansicolor(c1);
  1171.       End;
  1172.  
  1173.     Procedure GetCrazyVars;
  1174.       Begin
  1175.        If CrazyChat Then Begin
  1176.        c1:=configset.kkk1; c2:=configset.kkk2; c3:=configset.kkk3;
  1177.        c4:=configset.kkk4; c5:=configset.kkk5; c6:=configset.kkk6;
  1178.        c7:=configset.kkk7; c8:=configset.kkk8;
  1179.       End Else Begin
  1180.        c1:=urec.inputcolor;
  1181.        c2:=c1; c3:=c1; c4:=c1; c5:=c1; c6:=c1; c7:=c1; c8:=c1;
  1182.        End;
  1183.       End;
  1184.  
  1185. procedure init;
  1186. begin
  1187.   xsys     :=1;
  1188.   ysys     :=14;
  1189.   xusr     :=1;
  1190.   yusr     :=4;
  1191.   curcolor :=1;
  1192.   ec       :=1;
  1193.   initi    :=true;
  1194.   linebufs :='';
  1195.   linebufu :='';
  1196.   inuse:=2;
  1197. end;
  1198.  
  1199.  
  1200. procedure sendxy (x,y:byte);
  1201. begin
  1202.  write(#27+'[',y,';',x,'H');
  1203.  
  1204. end;
  1205.  
  1206.  
  1207. Procedure clearscre;
  1208.  var i:byte;
  1209.  begin
  1210.  for I:=4 to 22 do
  1211.   begin
  1212.    sendxy(1,i);
  1213.    write(#27'[K');
  1214.    end;
  1215.  end;
  1216.  
  1217.  
  1218. Procedure setc;
  1219. begin
  1220.    if fromkbd then ec:=urec.statcolor else ec:=urec.inputcolor;
  1221.    if curcolor<>ec then begin
  1222.    curcolor:=ec;
  1223.   end;
  1224. end;
  1225.  
  1226.  function parsedate (date:anystr):lstr;
  1227. const months: array[1..12] of string[3]=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
  1228.  
  1229. var m,d,y,inc,gog:sstr;
  1230.     year,month,day,dayofweek:word;
  1231. begin
  1232.  if length(date)<>8 then begin
  1233.   parsedate:=date;
  1234.   exit;
  1235.  end else
  1236.  begin
  1237.   m:=copy (date,1,2);
  1238.   d:=copy (date,4,2);
  1239.   y:=copy (date,7,2);
  1240.   gog:=months[valu(m)];
  1241.   getdate (year,month,day,dayofweek);
  1242.   inc:=copy (strr(year),1,2);
  1243.   parsedate:=gog+' '+d+' '+inc+y;
  1244.  end;
  1245. end;
  1246.  
  1247.  procedure midline;
  1248.  begin
  1249.    sendxy(1,13);
  1250.    write(^R'──────────────────────────'^S'  '^P'ViSiON '+versionnum+^S);
  1251.    write(' '^R'───────────────────────────');
  1252.    sendxy(trunc((21-length(configset.sysopnam))/2),13);
  1253.    write (^R'─ '^S+configset.sysopnam+^R' ─');
  1254.    sendxy(trunc((24-length(urec.handle))/2)+52,13);
  1255.    write (^R'─ '^S+urec.handle+^R' ─');
  1256.  end;
  1257.  
  1258. Procedure cle (malig:byte);
  1259. var i    :byte;
  1260. begin
  1261. if malig=0 then
  1262. begin
  1263.   for i:=14 to 22 do
  1264.  begin
  1265.     sendxy(1,i);
  1266.     write(#27'[K');
  1267.  end;
  1268.  sendxy(1,14);
  1269.  malig:=0;
  1270. end;
  1271.  
  1272. if malig=1 then
  1273. begin
  1274.  for i:=4 to 12 do
  1275.  begin
  1276.   sendxy(1,i);
  1277.   write(#27,'[K');
  1278.  end;
  1279.  sendxy(1,4);
  1280.  malig:=0;
  1281. end;
  1282. end;
  1283.  
  1284.  
  1285.  
  1286.   procedure wordwrapit(yeanea:byte);
  1287.   var cnt       :byte;
  1288.       wl        :integer;
  1289.       ww        :lstr;
  1290.       cutarea   :byte;
  1291.       done      :boolean;
  1292.   begin
  1293.    done:=false;
  1294.    cutarea:=0;
  1295.    ww:='';
  1296.    cnt:=80;
  1297.    if yeanea=0 then
  1298.      begin
  1299.       If Pos(' ',LineBufs)<=0 then Begin
  1300.         Writeln;
  1301.         LineBufs:='';
  1302.         Xsys:=1;
  1303.         Inc(Ysys);
  1304.         Exit;
  1305.       End;
  1306.     repeat
  1307.       if not done and (copy(linebufs,cnt,1)=' ') then cutarea:=cnt;
  1308.       if (cutarea>0) and not done then
  1309.         begin
  1310.         ww:=copy(linebufs,cnt+1,255);
  1311.          ansicolor(urec.statcolor);
  1312.          sendxy(cutarea,ysys);
  1313.          write(#27'[K');
  1314.          inc(ysys);
  1315.          xsys:=1;
  1316.          sendxy(xsys,ysys);
  1317.          write(copy(linebufs,cutarea+1,80-cutarea));
  1318.          xsys:=length(copy(linebufs,cutarea+1,80-cutarea))+1;
  1319.          sendxy(xsys,ysys);
  1320.          dec(ysys);
  1321.          done:=true
  1322.         end;
  1323.       dec(cnt);
  1324.      until cnt=1;
  1325.     linebufs:=ww;
  1326.    end;
  1327.  
  1328.    if yeanea=1 then
  1329.    begin
  1330.     If Pos(' ',LineBufu)<=0 then Begin
  1331.        Writeln;
  1332.        Inc(Yusr);
  1333.        Xusr:=0;
  1334.        LineBufu:='';
  1335.        Exit;
  1336.     End;
  1337.    done:=false;
  1338.    cutarea:=0;
  1339.    ww:='';
  1340.    cnt:=80;
  1341.     repeat
  1342.       if not done and (copy(linebufu,cnt,1)=' ') then cutarea:=cnt;
  1343.       if (cutarea>0) and not done then
  1344.         begin
  1345.         ww:=copy(linebufu,cnt+1,255);
  1346.          ansicolor(urec.inputcolor);
  1347.          sendxy(cutarea,yusr);
  1348.          write(#27'[K');
  1349.          inc(yusr);
  1350.          xusr:=1;
  1351.          sendxy(xusr,yusr);
  1352.          write(copy(linebufu,cutarea+1,80-cutarea));
  1353.          xusr:=length(copy(linebufu,cutarea+1,80-cutarea))+1;
  1354.          sendxy(xusr,yusr);
  1355.          dec(yusr);
  1356.          done:=true
  1357.         end;
  1358.       dec(cnt);
  1359.      until cnt=1;
  1360.     linebufu:=ww;
  1361.    end;
  1362.  
  1363. end;
  1364.  
  1365.  
  1366.  Procedure locate;
  1367.  begin
  1368.    if fromkbd then
  1369.  begin
  1370.  
  1371.      if (xsys=80) and (ysys<21) then
  1372.     begin
  1373.      wordwrapit(0);
  1374.      inc(ysys);
  1375.     end;
  1376.     if ((ysys=21) and (xsys=80)) or (ysys>21) then
  1377.     begin
  1378.     cle(0);
  1379.     ysys:=14;
  1380.     xsys:=1;
  1381.     sendxy(xsys,ysys);
  1382.     ansicolor(urec.statcolor);
  1383.     write(linebufs);
  1384.     sendxy(80-length(linebufs)+1,ysys);
  1385.     wordwrapit(0);
  1386.     inc(ysys);
  1387.     sendxy(xsys,ysys);
  1388.  end;
  1389.  
  1390.   sendxy(xsys,ysys);
  1391.   inc(xsys);
  1392.  end;
  1393.    if not fromkbd then
  1394.  begin
  1395.    if (xusr=80) and (yusr<12) then
  1396.   begin
  1397.    wordwrapit(1);
  1398.    inc(yusr);
  1399.   end;
  1400. if ((yusr=12) and (xusr=80)) or (yusr>12) then
  1401.  begin
  1402.    cle(1);
  1403.    yusr:=4;
  1404.    xusr:=1;
  1405.    sendxy(xusr,yusr);
  1406.    ansicolor(urec.inputcolor);
  1407.    write(linebufu);
  1408.    sendxy(80-length(linebufu)+1,yusr);
  1409.    wordwrapit(1);
  1410.    inc(yusr);
  1411.    sendxy(xusr,yusr);
  1412.  end;
  1413.  
  1414.    sendxy(xusr,yusr);
  1415.    inc(xusr);
  1416.  end;
  1417. end;
  1418.  
  1419.   procedure instruct;
  1420.   var i:integer;
  1421.   begin
  1422.  for i:=1 to 5 do
  1423.    begin
  1424.      sendxy(1,i);
  1425.      write(#27,'[K');
  1426.      end;
  1427.     sendxy(1,4);
  1428.   end;
  1429.  
  1430.  
  1431.   procedure typedchar (k:char);
  1432.  
  1433.   begin
  1434.  
  1435.    locate;
  1436.    begin;
  1437.    if fromkbd then begin
  1438.      If CrazyChat then ChangeVars Else Begin
  1439.      ansicolor(urec.statcolor); linebufs:=linebufs+K;
  1440.    end;
  1441.    end;
  1442.    if not fromkbd then begin
  1443.      If CrazyChat then ChangeVars Else Begin
  1444.      ansicolor(urec.inputcolor); linebufu:=linebufu+K;
  1445.    end;
  1446.    end;
  1447.     write(k)
  1448.    end;
  1449.   end;
  1450.  
  1451. begin
  1452.   carrierloss:=false;
  1453.   chatmode:=false;
  1454.   writeln (^B^M);
  1455.   if wanted in urec.config then begin
  1456.     specialmsg ('(No longer wanted)');
  1457.     urec.config:=urec.config-[wanted];
  1458.     writeurec;
  1459.   end;
  1460.   if eightycols in urec.config then displaywid:=80 else displaywid:=40;
  1461.   if gotospecial then begin
  1462.     specialseries;
  1463.     exit
  1464.   end;
  1465.   clearbreak;
  1466.   nobreak:=true;
  1467.   writeln (^M^M,configset.entercha,^M^R);
  1468.   StartedTime:=TimeLeft;
  1469.   instruct;
  1470.   if not initi then
  1471. begin
  1472.    init;
  1473.    clearscre;
  1474.    midline;
  1475.    CrazyChat:=TRue;
  1476.    If CrazyChat then GetCrazyVars;
  1477. end;
  1478.  
  1479.   quit:=false;
  1480.   repeat
  1481.     linecount:=0;
  1482.     if (not carrierloss) and (not carrier) then begin
  1483.       carrierloss:=true;
  1484.       gotoxy(1,4);
  1485.       writeln (^M'NO CARRIER...'^M)
  1486.     end;
  1487.     repeat until keyhit or (carrier and (numchars>0));
  1488.     fromkbd:=keyhit;
  1489.     ingetstr:=true;
  1490.     read (directin,k);
  1491.     if k=#127 then k:=#8;
  1492.     if requestchat
  1493.       then if requestcom
  1494.         then
  1495.           begin
  1496.             quit:=specialcommand;
  1497.             if not quit then instruct;
  1498.             clearbreak;
  1499.             nobreak:=true;
  1500.           end
  1501.         else
  1502.           begin
  1503.             unsplit;
  1504.             writeln (^M^M,configset.exitcha,^M^R);
  1505.         SetTimeLeft(StartedTime);
  1506.         bottomline;
  1507.         clearscre;
  1508.             quit:=true
  1509.           end;
  1510.     case ord(k) of
  1511.       8:begin
  1512.       if (xsys>1) and fromkbd then
  1513.        begin
  1514.           modeminlock:=true;
  1515.           if xsys>1 then dec(xsys);
  1516.           sendxy(xsys,ysys);
  1517.           write (' ');
  1518.           sendxy(xsys,ysys);
  1519.           if length(linebufs)>0 then linebufs:=copy(linebufs,1,length(linebufs)-1);
  1520.           modeminlock:=false;
  1521.         end;
  1522.       if (xusr>1) and not fromkbd then
  1523.        begin
  1524.           modeminlock:=true;
  1525.           if xusr>1 then dec(xusr);
  1526.           sendxy(xusr,yusr);
  1527.           write (' ');
  1528.           sendxy(xsys,ysys);
  1529.           if length(linebufu)>0 then linebufu:=copy(linebufu,1,length(linebufu)-1);
  1530.           modeminlock:=false;
  1531.         end;
  1532.      end;
  1533.       0:;
  1534.       13:begin
  1535.            writeln;
  1536.            bottomline;
  1537.            if fromkbd then begin
  1538.            xsys:=1;
  1539.            inc(ysys);
  1540.        if (ysys>=21) then
  1541.        begin
  1542.        cle(0);
  1543.        ysys:=14;
  1544.        xsys:=1;
  1545.        sendxy(xsys,ysys);
  1546.        ansicolor(urec.statcolor);
  1547.        write(linebufs);
  1548.        ysys:=15;
  1549.        xsys:=1;
  1550.        end;
  1551.        sendxy(xsys,ysys);
  1552.        linebufs:='';
  1553.        end;
  1554.  
  1555.           if not fromkbd then begin
  1556.            xusr:=1;
  1557.            inc(yusr);
  1558.        if (yusr=13) then
  1559.               begin
  1560.                  cle(1);
  1561.                   yusr:=4;
  1562.                   xusr:=1;
  1563.                    ansicolor(urec.inputcolor);
  1564.                   sendxy(xusr,yusr);
  1565.                   write(linebufu);
  1566.                   yusr:=5;
  1567.                   sendxy(xusr,yusr);
  1568.               end;
  1569.             sendxy(xusr,yusr);
  1570.           linebufu:='';
  1571.           end;
  1572.          end;
  1573.       32..255:typedchar (k);
  1574.       1..31:if fromkbd and carrier then sendchar(k);
  1575.     end
  1576.   until quit;
  1577.   clearbreak
  1578. end;
  1579.  
  1580. Procedure regchat;
  1581. VAR k:char;
  1582.     cnt,displaywid:integer;
  1583.     StartedTime:Word;
  1584.     quit,carrierloss,fromkbd:boolean;
  1585.     linebuffer:lstr;
  1586.     l:byte absolute linebuffer;
  1587.     curcolor:byte;
  1588.  
  1589.   Procedure wordwrap;
  1590.   VAR cnt,wl:integer;
  1591.       ww:lstr;
  1592.   begin
  1593.     ww:='';
  1594.     cnt:=displaywid;
  1595.     while (cnt>0) and (linebuffer[cnt]<>' ') do cnt:=cnt-1;
  1596.     if cnt=0 then ww:=k else begin
  1597.       ww:=copy(linebuffer,cnt+1,255);
  1598.       wl:=length(ww)-1;
  1599.       if wl>0 then begin
  1600.         for cnt:=1 to wl do write (^H);
  1601.         for cnt:=1 to wl do write (' ')
  1602.       end
  1603.     end;
  1604.     writeln;
  1605.     ansicolor (curcolor);
  1606.     write (ww);
  1607.     linebuffer:=ww
  1608.   end;
  1609.  
  1610.   Procedure typedchar (k:char);
  1611.   VAR ec:byte;
  1612.   begin
  1613.     l:=l+1;
  1614.     linebuffer[l]:=k;
  1615.     if l=displaywid then wordwrap else write(k)
  1616.   end;
  1617.  
  1618. VAR Ch : CHAR;
  1619.     inchat:boolean;
  1620. begin
  1621.   While Keypressed DO
  1622.     Ch := ReadKey;
  1623.   Writeln(^M);
  1624.   carrierloss := false;
  1625.   chatmode := false;
  1626.   InChat := TRUE;
  1627.   writeln(^B);
  1628.   if (wanted in urec.config) AND (Ulvl < 90)  then begin
  1629.     specialmsg ('(No longer wanted)');
  1630.     urec.config:=urec.config-[wanted];
  1631.     writeurec;
  1632.   end;
  1633.   if eightycols in urec.config then displaywid:=80 else displaywid:=40;
  1634.   if length(chatreason)>0 then specialmsg ('(Chat reason: '+chatreason+')');
  1635.   chatreason:='';
  1636.   clearbreak;
  1637.   nobreak := TRUE;
  1638.   Writeln (^M^M^R,configset.entercha,^M^M);
  1639.   StartedTime:=TimeLeft;
  1640.   quit:=false;
  1641.   l:=0;
  1642.   curcolor:=urec.regularcolor;
  1643.   repeat
  1644.     linecount:=0;
  1645.     if (not carrierloss) and (not carrier) then begin
  1646.       carrierloss:=true;
  1647.       writeln (^M'Warning: No Carrier detected.'^M)
  1648.     end;
  1649.     repeat until keyhit or (carrier and (numchars>0));
  1650.     fromkbd:=keyhit;
  1651.     ingetstr:=true;
  1652.     curcolor:=urec.inputcolor;
  1653.     if not keyhit then read(directin,k) else begin curcolor:=urec.statcolor;
  1654.     K:=bioskey;
  1655.     if (ord(k)>127) then if ((ord(k)-128)=chatchar) then inchat:=false;
  1656.     if (ord(k)>127) then if ((ord(k)-129)=chatchar) then begin specialseries;
  1657.     inchat:=false;
  1658.     end;
  1659.     end;
  1660.     ansicolor(curcolor);
  1661.     if k=#127 then k:=#8;
  1662.     Quit := NOT Inchat;
  1663.     if quit then k:=#0;
  1664.     case ord(k) of
  1665.       8:if l>0 then begin
  1666.           write (k+' '+k);
  1667.           l:=l-1
  1668.         end;
  1669.       0:;
  1670.       13:begin
  1671.            writeln;
  1672.            bottomline;
  1673.            l:=0
  1674.          end;
  1675.       32..255:typedchar (k);
  1676.       1..31:if fromkbd and carrier then sendchar(k)
  1677.     end
  1678.   until quit;
  1679.   UnSplit;
  1680.   ClearBreak;
  1681.   Writeln(^M^M^R,configset.exitcha,^M);
  1682.   SetTimeLeft(StartedTime);
  1683.   bottomline;
  1684. End;
  1685.  
  1686.  
  1687. begin
  1688. end.
  1689.